; ORIGINAL: 3dt2.1/examples/testload.scm
; $Id: testload.scm,v 1.4 1997/04/30 20:24:23 jread Exp $
;; This file provides the procedure testload.  testload is like
;; load, but it will display the results of each evaluation as it reads
;; the file, and it will catch errors and continue reading the file.

(define top-level-environment (the-environment))

(define (error-string error-msg)
  (string-append
   (format #f "~s: " (car error-msg))
   (apply format #f (cdr error-msg))
   ))

(define testload
  (lambda (input-file-name output-file-name)
    (let ((in (open-input-file input-file-name))
          (out (open-output-file output-file-name))
          )
      (format out "Evaluating file ~a~%" input-file-name)
      (let loop ()
        (let ((expr (read in)))
          (format out "---> ~a~%" expr)
          (if (not (eof-object? expr))
              (let ((result
                     (call-with-current-continuation
                      (lambda (catch)
                        (fluid-let
                            ((error-handler
                              (lambda msg
                                (format out "~a~%~a~%" "*** Error"
                                        (error-string msg))
                                (catch #f)
                                )))
                          (eval expr top-level-environment)
                          )))))
                (print result out)
                (loop)
                ))))
      (close-input-port in)
      (close-output-port out)
      )))
